home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / tsipp / tsipp.lha / tsipp3.0a / src / tSippShader.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-02  |  24.6 KB  |  700 lines

  1. /*
  2.  *=============================================================================
  3.  *                                  tSippShader.c
  4.  *-----------------------------------------------------------------------------
  5.  * Tcl commands to set SIPP shader type and parameters.
  6.  *-----------------------------------------------------------------------------
  7.  * Copyright 1992 Mark Diekhans
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Mark Diekhans makes
  11.  * no representations about the suitability of this software for any purpose.
  12.  * It is provided "as is" without express or implied warranty.
  13.  *-----------------------------------------------------------------------------
  14.  * $Id: tSippShader.c,v 2.0 1992/11/02 03:56:37 markd Rel $
  15.  *=============================================================================
  16.  */
  17.  
  18. #include "tSippInt.h"
  19. #include "shaders.h"
  20.  
  21. extern void phong_shader();  /* ???Should be in sipp.h, but was deleted. */
  22.  
  23. /*
  24.  * A shader definition.
  25.  */
  26. typedef struct {
  27.     Shader  *proc;
  28.     void    *surfDescPtr;
  29.     int      surfDescSize;
  30. } shaderDesc_t, *shaderDesc_pt;
  31.  
  32. /*
  33.  * Default opacity is completely opaque.
  34.  */
  35. static Color defaultOpacity = {1.0, 1.0, 1.0};
  36.  
  37. /*
  38.  * Internal prototypes.
  39.  */
  40. static void
  41. BindShaderToHandle _ANSI_ARGS_((tSippGlob_pt     tSippGlobPtr,
  42.                                 Shader          *shaderProc,
  43.                                 void            *surfDescPtr,
  44.                                 int              surfDescSize,
  45.                                 bool             passDesc));
  46.  
  47. /*=============================================================================
  48.  * BindShaderToHandle --
  49.  *   Bind a shader and surface description to a handle, setting up the
  50.  *   table entry.
  51.  *
  52.  * Parameters:
  53.  *   o tSippGlobPtr (I) - Pointer to the Tcl SIPP globals.  The handle is
  54.  *     returned in interp->result.
  55.  *   o shaderProc (I) - A pointer to the shader procedure.
  56.  *   o surfDescPtr (I) - A pointer to the surface descriptor.
  57.  *   o surfDescSize (I) - The size of the surface descriptor.
  58.  *   o passDesc (I) - If TRUE, then surfDescPtr is dynamically allocated
  59.  *     and ownership is passed to this routine.  Otherwise it is assumed to be
  60.  *     a static and a copy is made.
  61.  *-----------------------------------------------------------------------------
  62.  */
  63. static void
  64. BindShaderToHandle (tSippGlobPtr, shaderProc, surfDescPtr, surfDescSize,
  65.                     passDesc)
  66.     tSippGlob_pt     tSippGlobPtr;
  67.     Shader          *shaderProc;
  68.     void            *surfDescPtr;
  69.     int              surfDescSize;
  70.     bool             passDesc;
  71. {
  72.     shaderDesc_pt  descPtr;
  73.     shaderDesc_pt *descEntryPtr;
  74.  
  75.     descPtr = (shaderDesc_pt) ckalloc (sizeof (shaderDesc_t));
  76.     if (passDesc) {
  77.         descPtr->surfDescPtr = surfDescPtr;
  78.     } else {
  79.         descPtr->surfDescPtr = ckalloc (surfDescSize);
  80.         memcpy (descPtr->surfDescPtr, surfDescPtr, surfDescSize);
  81.     }
  82.     descPtr->proc = shaderProc;
  83.     descPtr->surfDescSize = surfDescSize;
  84.  
  85.     descEntryPtr = (shaderDesc_pt *)
  86.         Tcl_HandleAlloc (tSippGlobPtr->shaderTblPtr, 
  87.                          tSippGlobPtr->interp->result);
  88.     *descEntryPtr = descPtr;
  89. }
  90.  
  91. /*=============================================================================
  92.  * TSippShaderHandleToPtr --
  93.  *   Utility procedure to convert an shader handle to an shader pointer.
  94.  *   For use of by functions outside of this module.
  95.  * Parameters:
  96.  *   o tSippGlobPtr (I) - A pointer to the Tcl SIPP global structure.
  97.  *   o handle (I) - A shader handle.
  98.  *   o surfDescPtrPtr (O) - A pointer to the surface descritor is returned
  99.  *     here.
  100.  * Returns:
  101.  *   A pointer to the shader procedure, or NULL if an error occured.
  102.  *-----------------------------------------------------------------------------
  103.  */
  104. Shader *
  105. TSippShaderHandleToPtr (tSippGlobPtr, handle, surfDescPtrPtr)
  106.     tSippGlob_pt    tSippGlobPtr;
  107.     char           *handle;
  108.     void          **surfDescPtrPtr;
  109. {
  110.     shaderDesc_pt *descEntryPtr;
  111.     shaderDesc_pt  descPtr;
  112.  
  113.     descEntryPtr = (shaderDesc_pt *)
  114.         Tcl_HandleXlate (tSippGlobPtr->interp, 
  115.                          tSippGlobPtr->shaderTblPtr, handle);
  116.     if (descEntryPtr == NULL)
  117.         return NULL;
  118.     descPtr = *descEntryPtr;
  119.     *surfDescPtrPtr = descPtr->surfDescPtr;
  120.     return descPtr->proc;
  121.  
  122. } /* TSippShaderHandleToPtr */
  123.  
  124. /*=============================================================================
  125.  * SippShaderBasic --
  126.  *   Process the basic shader command:
  127.  *     SippShaderBasic ambient specular c3 color [opacity]
  128.  *
  129.  * Note:
  130.  *   This procedure has standard Tcl command calling sematics.  ClientData
  131.  * contains a pointer to the Tcl SIPP global structure.
  132.  *-----------------------------------------------------------------------------
  133.  */
  134. static int
  135. SippShaderBasic (clientData, interp, argc, argv)
  136.     char       *clientData;
  137.     Tcl_Interp *interp;
  138.     int         argc;
  139.     char      **argv;
  140. {
  141.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  142.     Surf_desc    surfDesc;
  143.  
  144.     if ((argc < 5) || (argc > 6)) {
  145.         Tcl_AppendResult (interp, "wrong # args: ", argv [0],
  146.                           " ambient specular c3 color [opacity]",
  147.                           (char *) NULL);
  148.         return TCL_ERROR;
  149.     }
  150.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  151.         return TCL_ERROR;
  152.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.specular))
  153.         return TCL_ERROR;
  154.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.c3))
  155.         return TCL_ERROR;
  156.     if (!TSippConvertColor (tSippGlobPtr, argv [4], &surfDesc.color))
  157.         return TCL_ERROR;
  158.     if (argc == 6) {
  159.         if (!TSippConvertOpacity (tSippGlobPtr, argv [5], &surfDesc.opacity))
  160.             return TCL_ERROR;
  161.     } else
  162.         surfDesc.opacity = defaultOpacity;
  163.  
  164.     BindShaderToHandle (tSippGlobPtr, basic_shader, 
  165.                         &surfDesc, sizeof (surfDesc), FALSE);
  166.     return TCL_OK;
  167.  
  168. } /* SippShaderBasic */
  169.  
  170. /*=============================================================================
  171.  * SippShaderPhong --
  172.  *   Process the Phong shader command:
  173.  *     SippShaderPhong ambient diffuse specular spec_exp color [opacity]
  174.  *
  175.  * Note:
  176.  *   This procedure has standard Tcl command calling sematics.  ClientData
  177.  * contains a pointer to the Tcl SIPP global structure.
  178.  *-----------------------------------------------------------------------------
  179.  */
  180. static int
  181. SippShaderPhong (clientData, interp, argc, argv)
  182.     char       *clientData;
  183.     Tcl_Interp *interp;
  184.     int         argc;
  185.     char      **argv;
  186. {
  187.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  188.     Phong_desc   surfDesc;
  189.  
  190.     if ((argc < 6) || (argc > 7)) {
  191.         Tcl_AppendResult (interp, "wrong # args: ", argv [0],
  192.                           " ambient diffuse specular spec_exp color [opacity]",
  193.                           (char *) NULL);
  194.         return TCL_ERROR;
  195.     }
  196.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  197.         return TCL_ERROR;
  198.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.diffuse))
  199.         return TCL_ERROR;
  200.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.specular))
  201.         return TCL_ERROR;
  202.     if (Tcl_GetInt (interp, argv [4], &surfDesc.spec_exp) != TCL_OK)
  203.         return TCL_ERROR;
  204.     if (!TSippConvertColor (tSippGlobPtr, argv [5], &surfDesc.color))
  205.         return TCL_ERROR;
  206.     if (argc == 7) {
  207.         if (!TSippConvertOpacity (tSippGlobPtr, argv [6], &surfDesc.opacity))
  208.             return TCL_ERROR;
  209.     } else
  210.         surfDesc.opacity = defaultOpacity;
  211.  
  212.     BindShaderToHandle (tSippGlobPtr, phong_shader,
  213.                         &surfDesc, sizeof (surfDesc), FALSE);
  214.     return TCL_OK;
  215.  
  216. } /* SippShaderPhong */
  217.  
  218. /*=============================================================================
  219.  * SippShaderStrauss --
  220.  *   Process the strauss shader command:
  221.  *     SippShaderStrauss ambient smoothness metalness color [opacity]
  222.  *
  223.  * Note:
  224.  *   This procedure has standard Tcl command calling sematics.  ClientData
  225.  * contains a pointer to the Tcl SIPP global structure.
  226.  *-----------------------------------------------------------------------------
  227.  */
  228. static int
  229. SippShaderStrauss (clientData, interp, argc, argv)
  230.     char       *clientData;
  231.     Tcl_Interp *interp;
  232.     int         argc;
  233.     char      **argv;
  234. {
  235.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  236.     Strauss_desc surfDesc;
  237.  
  238.     if ((argc < 5) || (argc > 6)) {
  239.         Tcl_AppendResult (interp, "wrong # args: ", argv [0],
  240.                           " ambient smoothness metalness color [opacity]",
  241.                           (char *) NULL);
  242.         return TCL_ERROR;
  243.     }
  244.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  245.         return TCL_ERROR;
  246.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.smoothness))
  247.         return TCL_ERROR;
  248.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.metalness))
  249.         return TCL_ERROR;
  250.     if (!TSippConvertColor (tSippGlobPtr, argv [4], &surfDesc.color))
  251.         return TCL_ERROR;
  252.     if (argc == 6) {
  253.         if (!TSippConvertOpacity (tSippGlobPtr, argv [5], &surfDesc.opacity))
  254.             return TCL_ERROR;
  255.     } else
  256.         surfDesc.opacity = defaultOpacity;
  257.  
  258.     BindShaderToHandle (tSippGlobPtr, strauss_shader, 
  259.                         &surfDesc, sizeof (surfDesc), FALSE);
  260.     return TCL_OK;
  261.  
  262. } /* SippShaderStrauss */
  263.  
  264. /*=============================================================================
  265.  * SippShaderWood --
  266.  *   Process the wood shader command:
  267.  *     SippShaderWood ambient specular c3 scale basecolor ringcolor [opacity]
  268.  *
  269.  * Note:
  270.  *   This procedure has standard Tcl command calling sematics.  ClientData
  271.  * contains a pointer to the Tcl SIPP global structure.
  272.  *-----------------------------------------------------------------------------
  273.  */
  274. static int
  275. SippShaderWood (clientData, interp, argc, argv)
  276.     char       *clientData;
  277.     Tcl_Interp *interp;
  278.     int         argc;
  279.     char      **argv;
  280. {
  281.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  282.     Wood_desc    surfDesc;
  283.  
  284.     if ((argc < 7) || (argc > 8)) {
  285.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], " ambient",
  286.                           " specular c3 scale basecolor ringcolor [opacity]",
  287.                           (char *) NULL);
  288.         return TCL_ERROR;
  289.     }
  290.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  291.         return TCL_ERROR;
  292.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.specular))
  293.         return TCL_ERROR;
  294.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.c3))
  295.         return TCL_ERROR;
  296.     if (Tcl_GetDouble (interp, argv [4], &surfDesc.scale) != TCL_OK)
  297.         return TCL_ERROR;
  298.     if (!TSippConvertColor (tSippGlobPtr, argv [5], &surfDesc.base))
  299.         return TCL_ERROR;
  300.     if (!TSippConvertColor (tSippGlobPtr, argv [6], &surfDesc.ring))
  301.         return TCL_ERROR;
  302.     if (argc == 8) {
  303.         if (!TSippConvertOpacity (tSippGlobPtr, argv [7], &surfDesc.opacity))
  304.             return TCL_ERROR;
  305.     } else
  306.         surfDesc.opacity = defaultOpacity;
  307.  
  308.     BindShaderToHandle (tSippGlobPtr, wood_shader, 
  309.                         &surfDesc, sizeof (surfDesc), FALSE);
  310.     return TCL_OK;
  311.  
  312. } /* SippShaderWood */
  313.  
  314. /*=============================================================================
  315.  * SippShaderMarble --
  316.  *   Process the marble shader command:
  317.  *     SippShaderMarble ambient specular c3 scale basecolor stripcolor
  318.  *                      [opacity]
  319.  *
  320.  * Note:
  321.  *   This procedure has standard Tcl command calling sematics.  ClientData
  322.  * contains a pointer to the Tcl SIPP global structure.
  323.  *-----------------------------------------------------------------------------
  324.  */
  325. static int
  326. SippShaderMarble (clientData, interp, argc, argv)
  327.     char       *clientData;
  328.     Tcl_Interp *interp;
  329.     int         argc;
  330.     char      **argv;
  331. {
  332.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  333.     Marble_desc  surfDesc;
  334.  
  335.     if ((argc < 7) || (argc > 8)) {
  336.         Tcl_AppendResult (tSippGlobPtr->interp, "wrong # args: ", argv [0],
  337.                           " ambient specular c3 scale basecolor stripcolor",
  338.                           " [opacity]", (char *) NULL);
  339.         return TCL_ERROR;
  340.     }
  341.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  342.         return TCL_ERROR;
  343.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.specular))
  344.         return TCL_ERROR;
  345.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.c3))
  346.         return TCL_ERROR;
  347.     if (Tcl_GetDouble (interp, argv [4], &surfDesc.scale) != TCL_OK)
  348.         return TCL_ERROR;
  349.     if (!TSippConvertColor (tSippGlobPtr, argv [5], &surfDesc.base))
  350.         return TCL_ERROR;
  351.     if (!TSippConvertColor (tSippGlobPtr, argv [6], &surfDesc.strip))
  352.         return TCL_ERROR;
  353.     if (argc == 8) {
  354.         if (!TSippConvertOpacity (tSippGlobPtr, argv [7], &surfDesc.opacity))
  355.             return TCL_ERROR;
  356.     } else
  357.         surfDesc.opacity = defaultOpacity;
  358.  
  359.     BindShaderToHandle (tSippGlobPtr, marble_shader, 
  360.                         &surfDesc, sizeof (surfDesc), FALSE);
  361.     return TCL_OK;
  362.  
  363. } /* SippShaderMarble */
  364.  
  365. /*=============================================================================
  366.  * SippShaderGranite --
  367.  *   Process the granite shader command:
  368.  *     SippShaderGranite ambient specular c3 scale color1 color2 [opacity]
  369.  *
  370.  * Note:
  371.  *   This procedure has standard Tcl command calling sematics.  ClientData
  372.  * contains a pointer to the Tcl SIPP global structure.
  373.  *-----------------------------------------------------------------------------
  374.  */
  375. static int
  376. SippShaderGranite (clientData, interp, argc, argv)
  377.     char       *clientData;
  378.     Tcl_Interp *interp;
  379.     int         argc;
  380.     char      **argv;
  381. {
  382.     tSippGlob_pt  tSippGlobPtr = (tSippGlob_pt) clientData;
  383.     Granite_desc  surfDesc;
  384.  
  385.     if ((argc < 7) || (argc > 8)) {
  386.         Tcl_AppendResult (tSippGlobPtr->interp, "wrong # args: ", argv [0],
  387.                           " ambient specular c3 scale color1 color2 [opacity]",
  388.                           (char *) NULL);
  389.         return TCL_ERROR;
  390.     }
  391.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  392.         return TCL_ERROR;
  393.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.specular))
  394.         return TCL_ERROR;
  395.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.c3))
  396.         return TCL_ERROR;
  397.     if (Tcl_GetDouble (interp, argv [4], &surfDesc.scale) != TCL_OK)
  398.         return TCL_ERROR;
  399.     if (!TSippConvertColor (tSippGlobPtr, argv [5], &surfDesc.col1))
  400.         return TCL_ERROR;
  401.     if (!TSippConvertColor (tSippGlobPtr, argv [6], &surfDesc.col2))
  402.         return TCL_ERROR;
  403.     if (argc == 8) {
  404.         if (!TSippConvertOpacity (tSippGlobPtr, argv [7], &surfDesc.opacity))
  405.             return TCL_ERROR;
  406.     } else
  407.         surfDesc.opacity = defaultOpacity;
  408.  
  409.     BindShaderToHandle (tSippGlobPtr, granite_shader, 
  410.                         &surfDesc, sizeof (surfDesc), FALSE);
  411.     return TCL_OK;
  412.  
  413. } /* SippShaderGranite */
  414.  
  415. /*=============================================================================
  416.  * SippShaderBozo --
  417.  *   Process the bozo shader command:
  418.  *     SippShaderBozo colorlist ambient specular c3 scale [opacity]
  419.  *
  420.  * Note:
  421.  *   This procedure has standard Tcl command calling sematics.  ClientData
  422.  * contains a pointer to the Tcl SIPP global structure.
  423.  *-----------------------------------------------------------------------------
  424.  */
  425. static int
  426. SippShaderBozo (clientData, interp, argc, argv)
  427.     char       *clientData;
  428.     Tcl_Interp *interp;
  429.     int         argc;
  430.     char      **argv;
  431. {
  432.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  433.     Bozo_desc   *surfDescPtr;
  434.     int          descSize;
  435.     char       **colorsArgv;
  436.     int          colorsArgc, idx;
  437.     Color       *colorsPtr;
  438.  
  439.     if ((argc < 6) || (argc > 7)) {
  440.         Tcl_AppendResult (tSippGlobPtr->interp, "wrong # args: ", argv [0],
  441.                           " colorlist ambient specular c3 scale [opacity]",
  442.                           (char *) NULL);
  443.         return TCL_ERROR;
  444.     }
  445.     /*
  446.      * Convert the color list, the array is part of the allocated surface
  447.      * descriptor.
  448.      */
  449.     if (Tcl_SplitList (tSippGlobPtr->interp, argv [1], &colorsArgc,
  450.                        &colorsArgv) != TCL_OK)
  451.         return TCL_ERROR;
  452.  
  453.     descSize = sizeof (Bozo_desc) + (colorsArgc * sizeof (Color));
  454.     surfDescPtr = (Bozo_desc *) ckalloc (descSize);
  455.     colorsPtr = (Color *) (((char *) surfDescPtr) + sizeof (Bozo_desc));
  456.     surfDescPtr->colors = colorsPtr;
  457.     surfDescPtr->no_of_cols = colorsArgc;
  458.  
  459.     for (idx = 0; idx < colorsArgc; idx++) {
  460.         if (!TSippConvertColor (tSippGlobPtr, colorsArgv [idx], 
  461.                                 &colorsPtr [idx])) {
  462.             goto errorExit;
  463.         }
  464.     }
  465.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDescPtr->ambient))
  466.         goto errorExit;
  467.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDescPtr->specular))
  468.         goto errorExit;
  469.     if (!TSippConvertFraction (tSippGlobPtr, argv [4], &surfDescPtr->c3))
  470.         goto errorExit;
  471.     if (Tcl_GetDouble (interp, argv [5], &surfDescPtr->scale) != TCL_OK)
  472.         goto errorExit;
  473.     if (argc == 7) {
  474.         if (!TSippConvertOpacity (tSippGlobPtr, argv [6],
  475.                                   &surfDescPtr->opacity))
  476.             return TCL_ERROR;
  477.     } else
  478.         surfDescPtr->opacity = defaultOpacity;
  479.     
  480.     BindShaderToHandle (tSippGlobPtr, bozo_shader, 
  481.                         surfDescPtr, descSize, TRUE);
  482.  
  483.     ckfree (colorsArgv);
  484.     return TCL_OK;
  485. errorExit:
  486.     ckfree (colorsArgv);
  487.     ckfree (surfDescPtr);
  488.     return TCL_ERROR;
  489.  
  490. } /* SippShaderBozo */
  491.  
  492. /*=============================================================================
  493.  * SippShaderBumpy --
  494.  *   Process the bumpy shader command:
  495.  *     SippShaderBumpy shaderhandle scale [BUMPS] [HOLES]
  496.  *
  497.  * Note:
  498.  *   This procedure has standard Tcl command calling sematics.  ClientData
  499.  * contains a pointer to the Tcl SIPP global structure.
  500.  *-----------------------------------------------------------------------------
  501.  */
  502. static int
  503. SippShaderBumpy (clientData, interp, argc, argv)
  504.     char       *clientData;
  505.     Tcl_Interp *interp;
  506.     int         argc;
  507.     char      **argv;
  508. {
  509.     tSippGlob_pt   tSippGlobPtr = (tSippGlob_pt) clientData;
  510.     Bumpy_desc    *surfDescPtr;
  511.     int            idx, surfDescSize;
  512.     shaderDesc_pt *otherDescPtrPtr, otherDescPtr;
  513.     double         scale;
  514.     bool           bumpflag, holeflag;
  515.  
  516.     if ((argc < 3) || (argc > 5)) {
  517.         Tcl_AppendResult (tSippGlobPtr->interp, "wrong # args: ", argv [0],
  518.                           " shaderhandle scale [BUMPS] [HOLES]",
  519.                           (char *) NULL);
  520.         return TCL_ERROR;
  521.     }
  522.     otherDescPtrPtr = (shaderDesc_pt *)
  523.         Tcl_HandleXlate (tSippGlobPtr->interp, 
  524.                          tSippGlobPtr->shaderTblPtr, argv [1]);
  525.     if (otherDescPtrPtr == NULL)
  526.         return TCL_ERROR;
  527.     otherDescPtr = *otherDescPtrPtr;
  528.  
  529.     if (Tcl_GetDouble (interp, argv [2], &scale) != TCL_OK)
  530.         return TCL_ERROR;
  531.  
  532.     bumpflag = holeflag = FALSE;
  533.  
  534.     for (idx = 3 ; idx < argc; idx ++) {
  535.         if (STREQU (argv [idx], "BUMPS"))
  536.             bumpflag = TRUE;
  537.         else if (STREQU (argv [idx], "HOLES"))
  538.             holeflag = TRUE;
  539.         else {
  540.             Tcl_AppendResult (tSippGlobPtr->interp, "expected one of `BUMPS'",
  541.                               " or `HOLES', got `", argv [idx], "'",
  542.                               (char *) NULL);
  543.             return TCL_ERROR;
  544.         }
  545.     }
  546.     if ((!bumpflag) && (!holeflag))
  547.         bumpflag = holeflag = TRUE;
  548.  
  549.     /*
  550.      * Build up a surface descriptor that includes the other surface
  551.      * descriptor as data.  This way it all gets freed up when we delete
  552.      * the bumpy shader.
  553.      */
  554.     surfDescSize = sizeof (Bumpy_desc) + otherDescPtr->surfDescSize;
  555.     surfDescPtr = (Bumpy_desc *) ckalloc (surfDescSize);
  556.  
  557.     surfDescPtr->shader = otherDescPtr->proc;
  558.     surfDescPtr->surface = ((char *) surfDescPtr) + sizeof (Bumpy_desc);
  559.     memcpy (surfDescPtr->surface, otherDescPtr->surfDescPtr, 
  560.             otherDescPtr->surfDescSize);
  561.  
  562.     surfDescPtr->bumpflag = bumpflag; 
  563.     surfDescPtr->holeflag = holeflag;
  564.     surfDescPtr->scale    = scale;
  565.  
  566.     BindShaderToHandle (tSippGlobPtr, bumpy_shader, 
  567.                         surfDescPtr, surfDescSize, TRUE);
  568.     return TCL_OK;
  569.  
  570. } /* SippShaderBumpy */
  571.  
  572. /*=============================================================================
  573.  * SippShaderPlanet --
  574.  *   Process the planet shader command:
  575.  *     SippShaderPlanet ambient specular c3 [opacity]
  576.  *
  577.  * Note:
  578.  *   This procedure has standard Tcl command calling sematics.  ClientData
  579.  * contains a pointer to the Tcl SIPP global structure.
  580.  *-----------------------------------------------------------------------------
  581.  */
  582. static int
  583. SippShaderPlanet (clientData, interp, argc, argv)
  584.     char       *clientData;
  585.     Tcl_Interp *interp;
  586.     int         argc;
  587.     char      **argv;
  588. {
  589.     tSippGlob_pt tSippGlobPtr = (tSippGlob_pt) clientData;
  590.     Surf_desc    surfDesc;
  591.  
  592.     if ((argc < 4) || (argc > 5)) {
  593.         Tcl_AppendResult (tSippGlobPtr->interp, "wrong # args: ", argv [0],
  594.                           " ambient specular c3 [opacity]", (char *) NULL);
  595.         return TCL_ERROR;
  596.     }
  597.     if (!TSippConvertFraction (tSippGlobPtr, argv [1], &surfDesc.ambient))
  598.         return TCL_ERROR;
  599.     if (!TSippConvertFraction (tSippGlobPtr, argv [2], &surfDesc.specular))
  600.         return TCL_ERROR;
  601.     if (!TSippConvertFraction (tSippGlobPtr, argv [3], &surfDesc.c3))
  602.         return TCL_ERROR;
  603.  
  604.     surfDesc.color.red = 0.0;  /* Ignored */
  605.     surfDesc.color.grn = 0.0;
  606.     surfDesc.color.blu = 0.0;
  607.  
  608.     if (argc == 5) {
  609.         if (!TSippConvertOpacity (tSippGlobPtr, argv [4], &surfDesc.opacity))
  610.             return TCL_ERROR;
  611.     } else
  612.         surfDesc.opacity = defaultOpacity;
  613.  
  614.     BindShaderToHandle (tSippGlobPtr, planet_shader, 
  615.                         &surfDesc, sizeof (surfDesc), FALSE);
  616.     return TCL_OK;
  617.  
  618. } /* SippShaderPlanet */
  619.  
  620. /*=============================================================================
  621.  * SippShaderDelete --
  622.  *   Implements the command:
  623.  *     SippShaderDelete shaderhandle
  624.  * Note:
  625.  *   This procedure has standard Tcl command calling sematics.  ClientData
  626.  * contains a pointer to the Tcl SIPP global structure.  This routine does not
  627.  * delete the allocated surface descriptior, as pointers to it are saved in
  628.  * SIPP data structures.
  629.  *-----------------------------------------------------------------------------
  630.  */
  631. static int
  632. SippShaderDelete (clientData, interp, argc, argv)
  633.     char       *clientData;
  634.     Tcl_Interp *interp;
  635.     int         argc;
  636.     char      **argv;
  637. {
  638.     tSippGlob_pt    tSippGlobPtr = (tSippGlob_pt) clientData;
  639.     int             idx;
  640.     handleList_t    shaderList;
  641.     handleList_t    shaderEntryList;
  642.  
  643.     if (argc != 2) {
  644.         Tcl_AppendResult (interp, "wrong # args: ", argv [0],
  645.                           " shaderlist", (char *) NULL);
  646.         return TCL_ERROR;
  647.     }                     
  648.     if (!TSippHandleListConvert (tSippGlobPtr, tSippGlobPtr->shaderTblPtr,
  649.                                  argv [1], &shaderList, &shaderEntryList))
  650.         return TCL_ERROR;
  651.  
  652.     /*
  653.      * Frees the entry and handle, but not the surface description.
  654.      */
  655.     for (idx = 0; idx < shaderList.len; idx++) {
  656.         ckfree (shaderList.ptr [idx]);  
  657.         Tcl_HandleFree (tSippGlobPtr->shaderTblPtr, 
  658.                         shaderEntryList.ptr [idx]);
  659.     }
  660.  
  661.     TSippHandleListFree (&shaderList);
  662.     TSippHandleListFree (&shaderEntryList);
  663.     return TCL_OK;
  664.  
  665. } /* SippShaderDelete */
  666.  
  667.  
  668. /*=============================================================================
  669.  * TSippShaderInit --
  670.  *   Initialized the shader commands.
  671.  *
  672.  * Parameters:
  673.  *   o tSippGlobPtr (I) - Pointer to the top level global data structure.
  674.  *-----------------------------------------------------------------------------
  675.  */
  676. void
  677. TSippShaderInit (tSippGlobPtr)
  678.     tSippGlob_pt  tSippGlobPtr;
  679. {
  680.     static tSippTclCmdTbl_t cmdTable [] = {
  681.         {"SippShaderBasic",   SippShaderBasic},
  682.         {"SippShaderPhong",   SippShaderPhong},
  683.         {"SippShaderStrauss", SippShaderStrauss},
  684.         {"SippShaderWood",    SippShaderWood},
  685.         {"SippShaderMarble",  SippShaderMarble},
  686.         {"SippShaderGranite", SippShaderGranite},
  687.         {"SippShaderBozo",    SippShaderBozo},
  688.         {"SippShaderBumpy",   SippShaderBumpy},
  689.         {"SippShaderPlanet",  SippShaderPlanet},
  690.         {"SippShaderDelete",  SippShaderDelete},
  691.         {NULL,                NULL}
  692.     };
  693.  
  694.     tSippGlobPtr->shaderTblPtr = 
  695.         Tcl_HandleTblInit ("shader", sizeof (shaderDesc_t), 8);
  696.  
  697.     TSippInitCmds (tSippGlobPtr, cmdTable);
  698.  
  699. } /* TSippShaderInit */
  700.